Introduce C-h command dispatch function

Replace role of show-next-page with C-h-dispatch which immediately reads
a key and calls a command from C-h-map, which may be one of several
paging commands, a command to undo the last keypress, or a command to
directly access describe-prefix-bindings.

This commit does not include documenting these changes in the readme.

Note that several options become deprecated here as they no longer have
the same (if any effect).

diff --git a/which-key.el b/which-key.el
index 57f475368cd26b09791f708e4be385d2d82e202e..3a81d1f89bfab0b49d73ff0daf69f13b161d279e 100644 (file)
--- a/which-key.el
+++ b/which-key.el
@@ -247,12 +247,40 @@ prefixes in `which-key-paging-prefixes'"
 ;;   :group 'which-key
 ;;   :type '(repeat symbol))
 
-(defcustom which-key-use-C-h-for-paging t
+(defcustom which-key-use-C-h-commands t
   "Use C-h for paging if non-nil. Normally C-h after a prefix
   calls `describe-prefix-bindings'. This changes that command to
   a which-key paging command when which-key-mode is active."
   :group 'which-key
   :type 'boolean)
+(defvaralias 'which-key-use-C-h-for-paging
+  'which-key-use-C-h-commands)
+(make-obsolete-variable 'which-key-use-C-h-for-paging
+                        'which-key-use-C-h-commands
+                        "2015-12-2")
+
+(defvar which-key-C-h-map
+  (let ((map (make-sparse-keymap)))
+    (dolist (bind '(("\C-h" . which-key-show-standard-help)
+                    ("h" . which-key-show-standard-help)
+                    ("\C-n" . which-key-show-next-page-cycle)
+                    ("n" . which-key-show-next-page-cycle)
+                    ("\C-p" . which-key-show-previous-page-cycle)
+                    ("p" . which-key-show-previous-page-cycle)
+                    ("\C-u" . which-key-undo-key)
+                    ("u" . which-key-undo-key)))
+      (define-key map (car bind) (cdr bind)))
+    map)
+  "Keymap for C-h commands.")
+
+(defvar which-key--paging-functions '(which-key-C-h-dispatch
+                                      which-key-turn-page
+                                      which-key-show-next-page
+                                      which-key-show-next-page-cycle
+                                      which-key-show-next-page-no-cycle
+                                      which-key-show-previous-page-cycle
+                                      which-key-show-previous-page-no-cycle))
+
 
 (defcustom which-key-prevent-C-h-from-cycling t
   "When using C-h for paging, which-key overrides the default
@@ -262,6 +290,9 @@ prefixes in `which-key-paging-prefixes'"
   want which-key to cycle, set this to nil."
   :group 'which-key
   :type 'boolean)
+(make-obsolete-variable 'which-key-prevent-C-h-from-cycling
+                        "No longer applies. See `which-key-C-h-dispatch'"
+                        "2015-12-2")
 
 (defcustom which-key-allow-evil-operators (boundp 'evil-this-operator)
   "Allow popup to show for evil operators. The popup is normally
@@ -422,17 +453,17 @@ alongside the actual current key sequence when
              (lambda (prefix)
                (define-key map
                  (kbd (concat prefix " " which-key-paging-key))
-                 #'which-key-show-next-page))
+                 #'which-key-C-h-dispatch))
              which-key-paging-prefixes)
             map)
   (if which-key-mode
       (progn
         (setq which-key--echo-keystrokes-backup echo-keystrokes)
         (unless which-key--is-setup (which-key--setup))
-        (unless (eq prefix-help-command 'which-key-show-next-page)
+        (unless (member prefix-help-command which-key--paging-functions)
           (setq which-key--prefix-help-cmd-backup prefix-help-command))
-        (when which-key-use-C-h-for-paging
-            (setq prefix-help-command #'which-key-show-next-page))
+        (when which-key-use-C-h-commands
+          (setq prefix-help-command #'which-key-C-h-dispatch))
         (when which-key-show-remaining-keys
           (add-hook 'pre-command-hook #'which-key--lighter-restore))
         (add-hook 'pre-command-hook #'which-key--hide-popup)
@@ -502,13 +533,6 @@ starter kit for example."
   (setq which-key-key-replacement-alist
         (delete '("right" . "→") which-key-key-replacement-alist)))
 
-;; (defun which-key--setup-undo-key ()
-;;   "Bind `which-key-undo-key' in `which-key-undo-keymaps'."
-;;   (when (and which-key-undo-key which-key-undo-keymaps)
-;;     (dolist (map which-key-undo-keymaps)
-;;       (which-key-define-key-recursively
-;;        map (kbd which-key-undo-key) 'which-key-undo))))
-
 ;; (defun which-key--check-key-based-alist ()
 ;;   "Check (and fix if necessary) `which-key-key-based-description-replacement-alist'"
 ;;   (let ((alist which-key-key-based-description-replacement-alist)
@@ -781,7 +805,7 @@ total height."
 
 (defun which-key--hide-popup ()
   "This function is called to hide the which-key buffer."
-  (unless (eq real-this-command 'which-key-show-next-page)
+  (unless (member real-this-command which-key--paging-functions)
     (setq which-key--current-page-n nil
           which-key--using-top-level nil
           which-key--on-last-page nil)
@@ -1472,31 +1496,26 @@ area."
      delay nil (lambda () (let (message-log-max)
                             (message "%s" text))))))
 
-(defun which-key--next-page-hint (prefix-keys page-n n-pages)
+(defun which-key--next-page-hint (prefix-keys n-pages)
   "Return string for next page hint."
   (let* ((paging-key (concat prefix-keys " " which-key-paging-key))
-         (paging-key-bound (eq 'which-key-show-next-page
+         (paging-key-bound (eq 'which-key-C-h-dispatch
                                (key-binding (kbd paging-key))))
-         (key (if paging-key-bound which-key-paging-key "C-h"))
-         (next-page-n (format "pg %s" (1+ (mod (1+ page-n) n-pages))))
-         (use-descbind (and which-key--on-last-page which-key-use-C-h-for-paging
-                            which-key-prevent-C-h-from-cycling)))
-    (when (and (or (and (< 1 n-pages) which-key-use-C-h-for-paging)
-                   (and (< 1 n-pages) paging-key-bound)
-                   use-descbind)
+         (key (if paging-key-bound which-key-paging-key "C-h")))
+    (when (and (or (and (< 1 n-pages) which-key-use-C-h-commands)
+                   (and (< 1 n-pages) paging-key-bound))
                (not (and which-key-allow-evil-operators
                          (bound-and-true-p evil-this-operator))))
-      (propertize (format "[%s %s]" key
-                          (if use-descbind "help" next-page-n))
+      (propertize (format "[%s which-key cmds]" key)
                   'face 'which-key-note-face))))
 
 (defun which-key--get-popup-map ()
   (unless which-key--current-prefix
     (let ((map (make-sparse-keymap)))
-      (define-key map (kbd which-key-paging-key) #'which-key-show-next-page)
-      (when which-key-use-C-h-for-paging
+      (define-key map (kbd which-key-paging-key) #'which-key-C-h-dispatch)
+      (when which-key-use-C-h-commands
         ;; Show next page even when C-h is pressed
-        (define-key map (kbd "C-h") #'which-key-show-next-page))
+        (define-key map (kbd "C-h") #'which-key-C-h-dispatch))
       map)))
 
 (defun which-key--show-page (n)
@@ -1538,7 +1557,7 @@ enough space based on your settings and frame size." prefix-keys)
                                   prefix-w-face))
              (status-left (format (concat "%-" (int-to-string first-col-width) "s")
                                   status-left))
-             (nxt-pg-hint (which-key--next-page-hint prefix-keys page-n n-pages))
+             (nxt-pg-hint (which-key--next-page-hint prefix-keys n-pages))
              new-end lines first)
         (cond ((and (< 1 n-pages)
                     (eq which-key-show-prefix 'left))
@@ -1588,37 +1607,28 @@ enough space based on your settings and frame size." prefix-keys)
       (with-no-warnings
         (set-temporary-overlay-map (which-key--get-popup-map))))))
 
-(defun which-key-show-next-page ()
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; paging functions
+
+(defun which-key-turn-page (&optional backward)
   "Show the next page of keys.
 Will force an update if called before `which-key--update'."
-  (interactive)
   (cond
-   ;; on last page and want default C-h behavior
-   ((and which-key--current-page-n
-         which-key--on-last-page
-         which-key-use-C-h-for-paging
-         which-key-prevent-C-h-from-cycling)
-    (which-key--hide-popup-ignore-command)
-    (which-key--stop-timer)
-    (funcall which-key--prefix-help-cmd-backup)
-    (which-key--start-timer))
    ;; No which-key buffer showing
    ((null which-key--current-page-n)
     (let* ((keysbl
             (vconcat (butlast (append (this-single-command-keys) nil))))
            (next-event
             (mapcar (lambda (ev) (cons t ev)) (listify-key-sequence keysbl))))
-      (which-key--stop-timer)
       (setq unread-command-events next-event)
-      (which-key--create-buffer-and-show keysbl)
-      (which-key--start-timer)))
+      (which-key--create-buffer-and-show keysbl)))
    ;; which-key buffer showing. turn page
    (t
     (let ((next-event
            (mapcar (lambda (ev) (cons t ev)) (which-key--current-key-list)))
           (next-page
-           (if which-key--current-page-n (1+ which-key--current-page-n) 0)))
-      (which-key--stop-timer)
+           (if which-key--current-page-n
+               (+ which-key--current-page-n (if backward -1 1)) 0)))
       (setq unread-command-events next-event)
       (if which-key--last-try-2-loc
           (let ((which-key-side-window-location which-key--last-try-2-loc)
@@ -1627,6 +1637,52 @@ Will force an update if called before `which-key--update'."
         (which-key--show-page next-page))
       (which-key--start-paging-timer)))))
 
+;;;###autoload
+(defun which-key-show-standard-help ()
+  "Call the command in `which-key--prefix-help-cmd-backup'.
+Usually this is `describe-prefix-bindings'."
+  (interactive)
+  (which-key--hide-popup-ignore-command)
+  (funcall which-key--prefix-help-cmd-backup)
+  (which-key--start-timer))
+
+;;;###autoload
+(defun which-key-show-next-page-no-cycle ()
+  "Show next page of keys unless on the last page, in which case
+call `which-key-show-standard-help'."
+  (interactive)
+  (if (and which-key--current-page-n
+           which-key--on-last-page)
+      (which-key-show-standard-help)
+    (which-key-turn-page)))
+(defalias 'which-key-show-next-page 'which-key-show-next-page-no-cycle)
+(make-obsolete 'which-key-show-next-page 'which-key-show-next-page-no-cycle
+               "2015-12-2")
+
+;;;###autoload
+(defun which-key-show-previous-page-no-cycle ()
+  "Show previous page of keys unless on the first page, in which
+case do nothing."
+  (interactive)
+  (if (and which-key--current-page-n
+           (eq which-key--current-page-n 0))
+      nil
+    (which-key-turn-page t)))
+
+;;;###autoload
+(defun which-key-show-next-page-cycle ()
+  "Show the next page of keys, cycling from end to beginning
+after last page."
+  (interactive)
+  (which-key-turn-page))
+
+;;;###autoload
+(defun which-key-show-previous-page-cycle ()
+  "Show the previous page of keys, cycling from beginning to end
+after first page."
+  (interactive)
+  (which-key-turn-page t))
+
 ;;;###autoload
 (defun which-key-show-top-level ()
   "Show top-level bindings."
@@ -1634,16 +1690,49 @@ Will force an update if called before `which-key--update'."
   (setq which-key--using-top-level t)
   (which-key--create-buffer-and-show nil))
 
-(defun which-key-undo ()
+;;;###autoload
+(defun which-key-undo-key ()
   "Undo last keypress and force which-key update."
   (interactive)
-  (let* ((key-str (this-command-keys))
-         (key-str (substring key-str 0 (- (length key-str) 2)))
-         (ev (mapcar (lambda (ev) (cons t ev)) (listify-key-sequence key-str))))
+  (let* ((key-lst (butlast (which-key--current-key-list) 1)))
+    (if key-lst
+        (progn
+          (setq unread-command-events
+                (mapcar (lambda (ev) (cons t ev)) key-lst))
+          (which-key--create-buffer-and-show
+           (key-description key-lst)))
+      (which-key-show-top-level)))
+  (which-key--start-timer))
+(defalias 'which-key-undo 'which-key-undo-key)
+
+(defun which-key-nil ()
+  "Abort key sequence."
+  (interactive)
+  (message "abort")
+  (which-key--start-timer))
+
+;;;###autoload
+(defun which-key-C-h-dispatch ()
+  "Dispatch C-h commands by looking up key in
+`which-key-C-h-map'. This command is always accessible (from any
+prefix) if `which-key-use-C-h-commands' is non nil."
+  (interactive)
+  (let* ((prefix-keys (key-description which-key--current-prefix))
+         (prefix-w-face (if (eq which-key-show-prefix 'echo) prefix-keys
+                          (which-key--propertize-key prefix-keys)))
+         (dash-w-face (if which-key--current-prefix
+                          (if (eq which-key-show-prefix 'echo) "-"
+                            (propertize "-" 'face 'which-key-key-face))
+                        ""))
+         (k (string
+             (read-key
+              (concat prefix-w-face dash-w-face
+                      (propertize "  [n]ext-page, [p]revious-page, [u]ndo-key, [h]elp"
+                                  'face 'which-key-note-face)))))
+         (cmd (lookup-key which-key-C-h-map k))
+         which-key-inhibit)
     (which-key--stop-timer)
-    (setq unread-command-events ev)
-    (which-key--create-buffer-and-show key-str)
-    (which-key--start-timer)))
+    (if cmd (funcall cmd) (which-key-nil))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Update
@@ -1727,7 +1816,7 @@ Finally, show the buffer."
   (setq which-key--paging-timer
         (run-with-idle-timer
          0.2 t (lambda ()
-                 (when (or (not (eq real-last-command 'which-key-show-next-page))
+                 (when (or (not (member real-last-command which-key--paging-functions))
                            (and (< 0 (length (this-single-command-keys)))
                                 (not (equal which-key--current-prefix
                                             (this-single-command-keys)))))